<?php

require_once("environment.php");
require_once("parser.php");
require_once("functionobject.php");
require_once("numberobject.php");
require_once("lambdaobject.php");
require_once("syntaxobject.php");
require_once("macroobject.php");
require_once("logicobject.php");
require_once("pairobject.php");

class Lisper {

    var $envData = array(
        "*this*" => array('this'),
        "*env*" => array('this-e'),
        "*true*" => array(),
        "*false*" => array(),
        "*true-enough*" => array(),
        "*gensym-string*" => array("SymbolObject", "GENSYM@", "no_self"),
        "*gensym-counter*" => array("NumberObject", 0, "no_self"),
        'print' => array("FunctionObject", 'do_print'),
        'first' => array("FunctionObject", 'do_first'),
        'car' => array("FunctionObject", 'do_first'),
        'replaca' => array("FunctionObject", 'do_replaca'),
        'second' => array("FunctionObject", 'do_second'),
        'cadr' => array("FunctionObject", 'do_second'),
        'third' => array("FunctionObject", 'do_third'),
        'rest' => array("FunctionObject", 'do_rest'),
        'cdr' => array("FunctionObject", 'do_rest'),
        'replacd' => array("FunctionObject", 'do_replacd'),
        'cons' => array("FunctionObject", 'do_cons'),
        'append' => array("FunctionObject", 'do_append'),
        'null?' => array("FunctionObject", 'do_nullp'),
        'list' => array("FunctionObject", 'do_list'),
        'assoc' => array("FunctionObject", 'do_assoc'),
        '+' => array("FunctionObject", 'do_add'),
        '-' => array("FunctionObject", 'do_sub'),
        '/' => array("FunctionObject", 'do_div'),
        '%' => array("FunctionObject", 'do_mod'),
        '*' => array("FunctionObject", 'do_mul'),
        '>' => array("FunctionObject", 'do_gt'),
        '>=' => array("FunctionObject", 'do_ge'),
        '<' => array("FunctionObject", 'do_lt'),
        '<=' => array("FunctionObject", 'do_le'),
        '==' => array("FunctionObject", 'do_eql'),
        'eql' => array("FunctionObject", 'do_eql'),
        '!=' => array("FunctionObject", 'do_neq'),
        'not' => array("FunctionObject", 'do_not'),
        'and' => array("FunctionObject", 'do_and'),
        'or' => array("FunctionObject", 'do_or'),
        'logic' => array("FunctionObject", 'do_logic'),
        'load' => array("FunctionObject", 'do_read'),
        'gensym' => array("FunctionObject", 'do_gensym'),
        'eval' => array("FunctionObject", 'do_eval'),
        'list?' => array("FunctionObject", 'do_listp'),
        'pair?' => array("FunctionObject", 'do_pairp'),
        'symbol?' => array("FunctionObject", 'do_symbolp'),
        'string?' => array("FunctionObject", 'do_stringp'),
        'number?' => array("FunctionObject", 'do_numberp'),
        'logic?' => array("FunctionObject", 'do_logicp'),
        'symbol-name' => array("FunctionObject", 'do_symbol_name'),
        'top-level' => array("FunctionObject", 'do_top_level'),
        'the-environment' => array("FunctionObject", 'do_the_environment'),
        'get-environment' => array("FunctionObject", 'do_get_environment'),
        'env-get' => array("FunctionObject", 'do_env_get'),
        'env-set' => array("FunctionObject", 'do_env_set'),
        'get' => array("FunctionObject", 'do_get'),
        'put' => array("FunctionObject", 'do_put'),
        'elt' => array("FunctionObject", 'do_elt'),
        'apply' => array("FunctionObject", 'do_apply'),
        //--------------------------------------
        'begin' => array("SyntaxObject", 'do_m_begin'),
        'setq' => array("SyntaxObject", 'do_m_setq'),
        'def' => array("SyntaxObject", 'do_m_setq'),
        'let' => array("SyntaxObject", 'do_m_let'),
        'lambda' => array("SyntaxObject", 'do_m_lambda'),
        'macro' => array("SyntaxObject", 'do_m_macro'),
        'macro-expand' => array("SyntaxObject", 'do_m_macro_expand'),
        'quote' => array("SyntaxObject", 'do_m_quote'),
        'i-quote' => array("SyntaxObject", 'do_m_iquote'),
        'if' => array("SyntaxObject", 'do_m_if'),
        'cond' => array("SyntaxObject", 'do_m_cond')
    );

    function Lisper() {
        $this->r = new Reader();
        $this->e = new Environment();
        $this->envData["*true*"][] = new LogicObject(1);
        $this->envData["*false*"][] = new LogicObject(0);
        $this->envData["*true-enough*"][] = new LogicObject(1);


        foreach ($this->envData as $symbol => $args) {
            $this->prepare_env($symbol, $args);
        }
        $this->init();
    }

    function init() {

    }

    function prepare_env($sym, $args) {
        if (count($args) == 1) {
            if ($args[0] == 'this') {
                $arg = $this;
            } elseif ($args[0] == 'this-e') {
                $arg = $this->e;
            } else {
                $arg = $args[0];
            }
        } elseif (isset($args[-1]) && $args[-1] == 'no_this') {
            $klass = $args[0];
            $param = $args[1];
            $arg = new $klass($param, $this);
        } else {
            $klass = $args[0];
            $attr = $args[1];
            $arg = new $klass($attr, $this);
        }
        $this->intern($sym, $arg);
    }

    function intern($sym, $val) {
        $this->e->set($sym, $val);
    }

    function lispeval($form) {
        return $form->lispeval($this->e);
    }

    function evalstring($str) {
        return $this->lispeval($this->r->get_sexpr($str));
    }

    function read($file) {
        if (!$f = @fopen($file, "r"))
            return false;
        $code = fread($f, filesize($file));
        fclose($f);

//		$code = ereg_replace(';.*(\n|$)', "", $code);

        $code = str_replace(";", '', $code);
        $code = str_replace("\n", '', $code);
        $code = str_replace("\r", '', $code);
        //              echo $code. "\n";
        $sexpr = $this->r->get_sexpr($code);
        while ($sexpr) {
            $this->lispeval($sexpr);
            $sexpr = $this->r->get_sexpr();
        }
        return true;
    }

    function get($sym, $property) {
        global $__PROPERTIES;
        if (isset($__PROPERTIES[$sym][$property])) {
            return $__PROPERTIES[$sym][$property];
        } else {
            return null;
        }
    }

    function push_e($env=null) {
        if ($env) {
            $this->e = $this->e->push($env);
        } else {
            $this->e = $this->e->push();
        }
    }

    function pop_e() {
        $this->e = $this->e->pop();
    }

    function unwind_e() {
        while ($this->e->parent) {
            $this->e = $this->e->parent;
        }
    }

    function lexical_intern($sym, $val) {
        $this->e->lexical_set($sym, $val);
    }

    public function do_print($env, $args) {
        foreach ($args as $a) {
            $result = $a->lispeval($env)->repr();
            echo $result;
        }
        echo "\n";
        return new LogicObject(1);
    }

    public function do_first($env, $args) {
        return $args[0]->lispeval($env)->first();
    }

    public function do_replaca($env, $args) {
        return $args[0]->lispeval($env)->replaca($args[1]->lispeval($env));
    }

    public function do_second($env, $args) {
        return $args[0]->lispeval($env)->second();
    }

    public function do_third($env, $args) {
        return $args[0]->lispeval($env)->third();
    }

    public function do_rest($env, $args) {
        return $args[0]->lispeval($env)->rest();
    }

    public function do_replacd($env, $args) {
        return $args[0]->lispeval($env)->replacd($args[1]->lispeval($env));
    }

    public function do_cons($env, $args) {
        return $args[1]->lispeval($env)->cons($args[0]->lispeval($env));
    }

    public function do_append($env, $args) {
        $lst = $args[0]->lispeval($env);
        foreach (array_slice($args, 1) as $l) {
            $lst->append($l->lispeval($env));
        }
        return $lst;
    }

    public function do_nullp($env, $args) {
        $lst = $args[0]->lispeval($env);
        if (get_class($lst) == "ListObject") {
            $lst = $lst->list;
        }
        if (is_array($lst)) {
            if (count($lst) == 0) {
                return new LogicObject(1);
            } else {
                return new LogicObject(0);
            }
        } else {
            return new LogicObject(1);
        }
    }

    public function do_list($env, $args) {
        $ans = array();
        foreach ($args as $n) {
            $ans[] = $n->lispeval($env);
        }
        return new ListObject($ans);
    }

    public function do_assoc($env, $args) {
        return $args[1]->lispeval($env)->assoc($args[0]->lispeval($env));
    }

    public function do_add($env, $args) {
        $ans = 0;
        foreach ($args as $n) {
            $ans = $n->lispeval($env)->add($ans);
        }
        return new NumberObject($ans);
    }

    public function do_sub($env, $args) {
        $ans = $args[0]->lispeval($env);

        if (isset($args[1])) {
            foreach (array_slice($args, 1) as $n) {
                $ans = $ans->sub($n->lispeval($env));
            }
        } else {
            $z = new NumberObject(0);
            $ans = $z->sub($ans);
        }
        return new NumberObject($ans);
    }

    public function do_div($env, $args) {
        $ans = $args[0]->lispeval($env);
        if (isset($args[1])) {
            foreach (array_slice($args, 1) as $n) {
                $ans = $ans->div($n->lispeval($env));
            }
        } else {
            # (/ 2) - give inverse
            $one = new NumberObject(1);
            $ans = $one->div($ans);
        }
        return new NumberObject($ans);
    }

    public function do_mod($env, $args) {
        $ans = $args[0]->lispeval($env);
        foreach (array_slice($args, 1) as $n) {
            $ans = $ans->mod($n->lispeval($env));
        }
        return new NumberObject($ans);
    }

    public function do_mul($env, $args) {
        $ans = $args[0]->lispeval($env);
        foreach (array_slice($args, 1) as $n) {
            $ans = $ans->mul($n->lispeval($env));
        }
        return new NumberObject($ans);
    }

    public function do_gt($env, $args) {
        if ($args[0]->lispeval($env)->cmp($args[1]->lispeval($env)) > 0) {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_ge($env, $args) {
        if ($args[0]->lispeval($env)->cmp($args[1]->lispeval($env)) >= 0) {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_lt($env, $args) {
        if ($args[0]->lispeval($env)->cmp($args[1]->lispeval($env)) < 0) {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_le($env, $args) {
        if ($args[0]->lispeval($env)->cmp($args[1]->lispeval($env)) <= 0) {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_eql($env, $args) {
        $a = $args[0]->lispeval($env);
        $b = $args[1]->lispeval($env);
        if ((get_class($a) == "SymbolObject") && (get_class($b) == "SymbolObject")) {
            if ($a->n == $b->n) {
                return new LogicObject(1);
            } else {
                return new LogicObject(0);
            }
        } else {
            if ($a == $b) {
                return new LogicObject(1);
            } else {
                return new LogicObject(0);
            }
        }
    }

    public function do_neq($env, $args) {
        if ($args[0]->lispeval($env)->cmp($args[1]->lispeval($env)) != 0) {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_not($env, $args) {
        return $args[0]->lispeval($env)->neg();
    }

    public function do_and($env, $args) {
        $ans = $args[0]->lispeval($env);
        foreach (array_slice($args, 1) as $arg) {
            $ans = $arg->lispeval($env)->logic_and($ans);
            # Short circuit once falsity is known.
            if ($ans->v == 0) {
                #if ans.nullp():
                break;
            }
        }
        return $ans;
    }

    public function do_or($env, $args) {
        $truth = $env->get('*true-enough*');
        $ans = $args[0]->lispeval($env);
        foreach (array_slice($args, 1) as $arg) {
            $ans = $ans->logic_or($arg->lispeval($env));
            if ($ans->v >= $truth->v) {
                break;
            }
        }
        return $ans;
    }

    public function do_logic($env, $args) {
        return new LogicObject($args[0]->lispeval($env));
    }

    public function do_read($env, $args) {
        if ($this->read($args[0]->lispeval($env)->repr()))
            return new LogicObject(1);
        else
            return new LogicObject(0);
    }

    public function do_gensym($env, $args) {
        $env->set('*gensym-counter*', ($env->get('*gensym-counter*') + 1));
        return new SymbolObject(
                $env->get('*gensym-string*')->repr() . $env->get('*gensym-counter*')
        );
    }

    public function do_eval($env, $args) {
        return $args[0]->lispeval($env)->lispeval($env);
    }

    public function do_listp($env, $args) {
        if (get_class($args[0]->lispeval($env)) == "ListObject") {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_pairp($env, $args) {
        if (get_class($args[0]->lispeval($env)) == "PairObject") {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_stringp($env, $args) {
        if (get_class($args[0]->lispeval($env)) == "StringObject") {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_symbolp($env, $args) {
        if (get_class($args[0]->lispeval($env)) == "SymbolObject") {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_numberp($env, $args) {
        if (get_class($args[0]->lispeval($env)) == "NumberObject") {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_logicp($env, $args) {
        if (get_class($args[0]->lispeval($env)) == "LogicObject") {
            return new LogicObject(1);
        } else {
            return new LogicObject(0);
        }
    }

    public function do_symbol_name($env, $args) {
        $sym = $args[0]->lispeval($env);
        return new StringObject($sym->n);
    }

    public function do_top_level($env, $args) {
        $this->unwind_e();
        return new LogicObject(1);
    }

    public function do_the_environment($env, $args) {
        return $this->e;
    }

    public function do_get_environment($env, $args) {
        $form = $args[0]->lispeval($env);
        if (
                (get_class($form) == "LambdaObject") ||
                (get_class($form) == "MacroObject")
        ) {
            return $form->env;
        } else {
            echo "Error! get-environment: must take lambda or macro";
            exit();
        }
    }

    public function do_env_get($env, $args) {
        $envform = $args[0]->lispeval($env);
        if (get_class($envform) == "Environment") {
            return $envform->get($args[1]->lispeval($env)->n);
        } else {
            echo "Error! env-get: must get environment as first argument";
            exit();
        }
    }

    public function do_env_set($env, $args) {
        $envform = $args[0]->lispeval($env);
        if (get_class($envform) == "Environment") {
            $value = $args[2]->lispeval($env);
            $envform->set($args[1]->lispeval($env)->n, $value);
            return $value;
        } else {
            echo "Error! env-set: must get environment as first argument";
            exit();
        }
    }

    public function do_put($env, $args) {
        $val = $args[2]->lispeval($env);
        $args[0]->lispeval($env)->put($args[1]->lispeval($env)->n, $val);
        return $val;
    }

    public function do_get($env, $args) {
        return $args[0]->lispeval($env)->get($args[1]->lispeval($env)->n);
    }

    public function do_elt($env, $args) {
        return $args[1]->lispeval($env)->getitem($args[0]->lispeval($env)->v);
    }

    public function do_apply($env, $args) {
        return $args[1]->lispeval($env)->cons($args[0])->lispeval($env);
    }

    public function do_m_lambda($env, $args) {
        if ($this->e->class_id == $env->get('*env*')->class_id) {
            return new LambdaObject($args[0], array_slice($args, 1), null);
        } else {
            return new LambdaObject($args[0], array_slice($args, 1), $env);
        }
    }

    public function do_m_setq($env, $args) {
        $this->intern($args[0]->n, $args[1]->lispeval($env));
        return $this->e->get($args[0]->n);
    }

    public function do_m_begin($env, $args) {
        $answer = new LogicObject(0);
        foreach ($args as $code) {
            $answer = $code->lispeval($env);
        }
        return $answer;
    }

    public function do_m_macro($env, $args) {
        if ($this->e == $env->get('*env*')) {
            return new MacroObject($args[0], array_slice($args, 1), null);
        } else {
            return new MacroObject($args[0], array_slice($args, 1), $env);
        }
    }

    //====
    public function do_m_macro_expand($env, $args) {
        return $args[0]->first()->lispeval($env)->expand($env, $args[0]->rest());
    }

    public function do_m_quote($env, $args) {
        return $args[0];
    }

    public function do_m_iquote($env, $args) {
        if (get_class($args[0]) == "ListObject") {
            return $args[0]->iquote($env);
        } else {
            return $args[0];
        }
    }

    public function do_m_let($env, $args) {
        global $G_QUOTE;
        $bindings = $args[0];
        $code = array_slice($args, 1);
        $arglist = array();
        $vallist = array();
        foreach ($bindings->list as $b) {
            if (get_class($b) == "SymbolObject") {
                $arglist[] = $b;
                $vallist[] = new ListObject(
                                array(
                                    $G_QUOTE,
                                    new ListObject(array())
                                )
                );
            } elseif (get_class($b) == "ListObject") {
                $arglist[] = $b->first();
                $vallist[] = $b->second();
            } else {
                echo "Error! malformed (let ...)";
                exit();
            }
        }
        $ans = new ListObject(
                        array_merge(
                                array(
                                    new ListObject(
                                            array_merge(
                                                    array(
                                                        new SymbolObject('lambda'),
                                                        new ListObject($arglist)
                                                    ),
                                                    $code
                                            )
                                    )
                                ),
                                $vallist
                        )
        );
        return $ans->lispeval($env);
    }

    public function do_m_if($env, $args) {
        $bool = $args[0]->lispeval($env);
        if (get_class($bool) == "LogicObject") {
            if ($bool->cmp($env->get('*true-enough*')) >= 0) {
                return $args[1]->lispeval($env);
            } else {
                if (count($args) == 3) {
                    return $args[2]->lispeval($env);
                } else {
                    return $bool;
                }
            }
        } elseif (method_exists($bool, 'nullp')) {
            if ($args[0]->lispeval($env)->nullp()->cmp(1) == 0) {
                if (count($args) == 3) {
                    return $args[2]->lispeval($env);
                } else {
                    return $bool;
                }
            } else {
                return $args[1]->lispeval($env);
            }
        } else {
            if ($bool == 0 || $bool == 0.0 || $bool == "") {
                if (count($args) == 3) {
                    return $args[2]->lispeval($env);
                } else {
                    return $bool;
                }
            } else {
                return $args[1]->lispeval($env);
            }
        }
    }

    public function do_m_cond($env, $args) {
        foreach ($args as $clause) {
            $bool = $clause->first()->lispeval($env);
            if (get_class($bool) == "LogicObject") {
                if ($bool >= $env->get('*true-enough*')) {
                    return $clause->second()->lispeval($env);
                }
            } elseif (method_exists($bool, 'nullp')) {
                if ($bool->nullp()->cmp(1) == 0) {
                    
                } else {
                    return $clause->second()->lispeval($env);
                }
            } else {
                if ($bool == 0 || $bool == 0.0 || $bool == "") {
                    
                } else {
                    return $clause->second()->lispeval($env);
                }
            }
        }
        return new LogicObject(0);
    }

}